unit mulselect;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, CheckLst, ExtCtrls, Buttons,db;

type
  TMulSelectForm = class(TForm)
    Panel1: TPanel;
    CheckListBox1: TCheckListBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure CheckListBox1Click(Sender: TObject);
    procedure CheckListBox1ClickCheck(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    CHECKCLICK:BOOLEAN;
    setOnlyOne:Boolean;
    selectValues:TStrings;
    selectItems:TStrings;
    values:TStrings;
    procedure SELEONLY(SENDER:TObject);
    function GetData(QUERY1: TDataSet; CheckListBox: TCheckListBox;
        selected:TStrings): TStrings;
    procedure SetChecked(selected: TStrings);


  public
    { Public declarations }          
    function StartSelect(inQuery1:TDataSet;
    var inSelectValues:TStrings; isOnlyOne:Boolean=false):TStrings;overload;
    function StartSelect(inquery1:TDataSet;
    var inSelectValues:String; isOnlyOne:Boolean=false):String;overload;
    procedure SETSELECT(SENDER: TObject);
    function GetSelectText(CheckListBox: TCheckListBox;
      isString: Boolean=true): String;
  end;

var
  MulSelectForm: TMulSelectForm;

implementation

{$R *.DFM}

{ TMulSelectForm }

function TMulSelectForm.StartSelect(inQuery1: TDataSet; 
  var inSelectValues: TStrings; isOnlyOne: Boolean): TStrings;
begin
    MulSelectForm:=TMulSelectForm.Create(Application);
    MulSelectForm.selectValues:=inSelectValues;
    MulSelectForm.selectItems:=TStringList.Create;
    MulSelectForm.setOnlyOne:=isOnlyOne;
    MulSelectForm.values:=MulSelectForm.GetData(inquery1,MulSelectForm.CheckListBox1,
        MulSelectForm.selectValues);
    MulSelectForm.CHECKCLICK:=FALSE;
    MulSelectForm.ShowModal;
    inSelectValues:=MulSelectForm.selectValues;
    Result:=MulSelectForm.selectItems;
    MulSelectForm.free;
end;

function TMulSelectForm.StartSelect(inquery1: TDataSet;
  var inSelectValues: String; isOnlyOne: Boolean): String;
begin
    MulSelectForm:=TMulSelectForm.Create(Application);
    MulSelectForm.selectValues:=TStringList.Create;
    MulSelectForm.selectItems:=TStringList.Create;
    MulSelectForm.selectValues.Text:=inSelectValues;
    MulSelectForm.setOnlyOne:=isOnlyOne;
    MulSelectForm.values:=MulSelectForm.GetData(inquery1,MulSelectForm.CheckListBox1,
        MulSelectForm.selectValues);
    MulSelectForm.CHECKCLICK:=FALSE;
    MulSelectForm.ShowModal;
    inSelectValues:=MulSelectForm.selectValues.Text;
    Result:=MulSelectForm.selectItems.Text;
    MulSelectForm.selectValues.Destroy;
    MulSelectForm.selectItems.Destroy;
    MulSelectForm.values.Destroy;
    MulSelectForm.free;
end;

procedure TMulSelectForm.SpeedButton1Click(Sender: TObject);
VAR I,J:INTEGER;
begin
J:=(Sender AS TSpeedButton).TAG;
FOR I:=1 TO CheckListBox1.Items.Count DO BEGIN
  CASE J OF
  1:CheckListBox1.Checked[I-1]:=TRUE;
  2:CheckListBox1.Checked[I-1]:=FALSE;
  3:CheckListBox1.Checked[I-1]:=NOT CheckListBox1.Checked[I-1];
  END;
  END;
end;

procedure TMulSelectForm.SELEONLY(SENDER: TObject);
VAR 
  I:INTEGER;
  T:BOOLEAN;
begin
  I:=(SENDER AS TCheckListBox).ItemIndex;
  IF (setOnlyOne)   THEN 
  BEGIN
    T:=CheckListBox1.Checked[I];
    SpeedButton1Click(SpeedButton2);
    CheckListBox1.Checked[I]:=T;
  END;
end;

procedure TMulSelectForm.CheckListBox1Click(Sender: TObject);
begin
  IF NOT CHECKCLICK THEN
  begin
     SETSELECT(SENDER);
  end;
  CHECKCLICK:=FALSE;
  SELEONLY(Sender);
end;

procedure TMulSelectForm.SETSELECT(SENDER:TObject);
VAR 
  I:INTEGER;
begin
  I:=(SENDER AS TCheckListBox).ItemIndex;
  (SENDER AS TCheckListBox).Checked[I]:=NOT ((SENDER AS TCheckListBox).Checked[I]);
end;

procedure TMulSelectForm.CheckListBox1ClickCheck(Sender: TObject);
begin
  CHECKCLICK:=TRUE;
  SELEONLY(Sender);
end;

FUNCTION TMulSelectForm.GetData(QUERY1:TDataSet;CheckListBox:TCheckListBox;
        selected:TStrings):TStrings;
VAR 
  I,J:INTEGER;
  S,S1:String;
  hasOneCheck:Boolean;
begin

  hasOneCheck:=false;
  Result:=TStringList.Create;
  CheckListBox.Clear;
  i:=0;
  while not Query1.Eof do
  BEGIN
    J:=QUERY1.FieldCount;
    inc(i);
    s:=Query1.Fields[0].AsString;
    case J of
       1: s1:=s;
       2: s1:=Query1.Fields[1].AsString
    else
      begin
        s:=s+Query1.Fields[2].AsString;
        s1:=Query1.Fields[1].AsString;
      end;
    end;
    CheckListBox.Items.Add(s);
    Result.Add(s1);
    If (not setOnlyOne) Or (not hasOneCheck) Then
    Begin
        If selected.IndexOf(s1)>=0 Then
        Begin
            hasOneCheck:=true;
            CheckListBox.Checked[i-1]:=true;
        End;
    End;
    Query1.Next;
  END;
END;

procedure TMulSelectForm.SpeedButton6Click(Sender: TObject);
begin
  close;
end;

procedure TMulSelectForm.SpeedButton4Click(Sender: TObject);
begin
  SetChecked(selectValues);
end;

procedure TMulSelectForm.SetChecked(selected:TStrings);
VAR 
  I:INTEGER;
  hasOneCheck:Boolean;
begin
  hasOneCheck:=false;
  for I := 0 to CheckListBox1.Items.Count-1 do
  begin
    If (setOnlyOne) And ( hasOneCheck) Then break;
    If selected.IndexOf(values.Strings[i])>=0 Then
    Begin
        hasOneCheck:=true;
        CheckListBox1.Checked[i]:=true;
    End Else
        CheckListBox1.Checked[i]:=false;
  end;
end;

procedure TMulSelectForm.SpeedButton5Click(Sender: TObject);
VAR 
  I:INTEGER;
begin
  selectValues.Clear;
  for I := 0 to CheckListBox1.Items.Count-1 do
  begin
    If CheckListBox1.Checked[i] Then
    Begin
        selectValues.Add(values[i]);
        selectItems.Add(CheckListBox1.Items.Strings[i]);
    End;
  end;
  close;
end;

procedure TMulSelectForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  close;
end;

function TMulSelectForm.GetSelectText(CheckListBox:TCheckListBox;isString:Boolean):String;
var 
  I:Integer;
  s:String;
begin
   Result:='';
   for i := 0 to CheckListBox.Items.Count-1 do
   begin
       If CheckListBox.Checked[i] Then
       Begin
           s:=CheckListBox.Items.Strings[i];
           If isString Then
               s:=''''+s+'''';
           If Result<>'' Then
               Result:=Result+',';
           Result :=Result+s;
       End;
   end;
end;

end.
